home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / dired-mob.el.z / dired-mob.el
Encoding:
Text File  |  1998-05-21  |  4.0 KB  |  123 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;
  3. ;; File:           dired-mob.el
  4. ;; RCS:
  5. ;; Dired Version:  #Revision: 7.9 $
  6. ;; Description:    Commands for marking files from another buffer.
  7. ;;
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9.  
  10. ;;; Requirements and provisions
  11. (provide 'dired-mob)
  12. (require 'dired)
  13. (autoload 'compilation-buffer-p "compile")
  14. (autoload 'compile-reinitialize-errors "compile")
  15.  
  16. ;; For the byte-compiler
  17. (defvar compilation-error-list)
  18.  
  19. ;;; Utilities
  20.  
  21. (defun dired-mark-these-files (file-list from)
  22.   ;; Mark the files in FILE-LIST.  Relative filenames are taken to be
  23.   ;; in the current dired directory.
  24.   ;; FROM is a string (used for logging) describing where FILE-LIST
  25.   ;; came from.
  26.   ;; Logs files that were not found and displays a success or failure
  27.   ;; message.
  28.   (message "Marking files %s..." from)
  29.   (let ((total (length file-list))
  30.     (cur-dir (dired-current-directory))
  31.     file failures)
  32.     (while file-list
  33.       (setq file (expand-file-name (car file-list) cur-dir)
  34.         file-list (cdr file-list))
  35.       ;;(message "Marking file `%s'" file)
  36.       (save-excursion
  37.     (if (dired-goto-file file)
  38.         (dired-mark 1) ; supplying a prefix keeps it from checking
  39.                ; for a subdir.
  40.       (setq failures (cons (dired-make-relative file) failures))
  41.       (dired-log (buffer-name (current-buffer))
  42.              "Cannot mark this file (not found): %s\n" file))))
  43.     (dired-update-mode-line-modified t)
  44.     (if failures
  45.     (dired-log-summary
  46.      (buffer-name (current-buffer))
  47.      (format "Failed to mark %d of %d files %s %s"
  48.          (length failures) total from failures) failures)
  49.       (message "Marked %d file%s %s." total (dired-plural-s total) from))))
  50.  
  51. ;;; User commands
  52.  
  53. (defun dired-mark-files-from-other-dired-buffer (buf)
  54.   "Mark files that are marked in the other Dired buffer.
  55. I.e, mark those files in this Dired buffer that have the same
  56. non-directory part as the marked files in the Dired buffer in the other 
  57. window."
  58.   (interactive (list (window-buffer (next-window))))
  59.   (if (eq (get-buffer buf) (current-buffer))
  60.       (error "Other dired buffer is the same"))
  61.   (or (stringp buf) (setq buf (buffer-name buf)))
  62.   (let ((other-files (save-excursion
  63.                (set-buffer buf)
  64.                (or (eq major-mode 'dired-mode)
  65.                (error "%s is not a dired buffer" buf))
  66.                (dired-get-marked-files 'no-dir))))
  67.     (dired-mark-these-files other-files (concat "from buffer " buf))))
  68.  
  69. (defun dired-mark-files-compilation-buffer (&optional buf)
  70.   "Mark the files mentioned in the `*compilation*' buffer.
  71. With a prefix, you may specify the other buffer."
  72.   (interactive
  73.    (list
  74.     (let ((buff  (let ((owin (selected-window))
  75.               found)
  76.           (unwind-protect
  77.               (progn
  78.             (other-window 1)
  79.             (while (null (or found (eq (selected-window) owin)))
  80.               (if (compilation-buffer-p
  81.                    (window-buffer (selected-window)))
  82.                   (setq found (current-buffer)))
  83.               (other-window 1)))
  84.             (select-window owin))
  85.           found)))
  86.       (if (or current-prefix-arg (null buff))
  87.       (let ((minibuffer-history
  88.          (delq nil
  89.               (mapcar
  90.                (function
  91.             (lambda (b)
  92.               (and (compilation-buffer-p b) (buffer-name b))))
  93.                (buffer-list)))))
  94.         (read-buffer "Use buffer: "
  95.              (or buff (car minibuffer-history))))
  96.     buff))))
  97.   (let ((dired-dir (directory-file-name default-directory))
  98.     files)
  99.     (save-window-excursion
  100.       (set-buffer buf)
  101.       (compile-reinitialize-errors nil (point-max))
  102.       (let ((alist compilation-error-list)
  103.         f d elt)
  104.     (while alist
  105.       (setq elt (car alist)
  106.         alist (cdr alist))
  107.       (and (consp (setq elt (car (cdr elt))))
  108.            (stringp (setq d (car elt)))
  109.            (stringp (setq f (cdr elt)))
  110.            (progn
  111.          (setq d (expand-file-name d))
  112.          (dired-in-this-tree d dired-dir))
  113.            (progn
  114.          (setq f (expand-file-name f d))
  115.          (not (member f files)))
  116.            (setq files (cons f files))))))
  117.     (dired-mark-these-files
  118.      files
  119.      (concat "From compilation buffer "
  120.          (if (stringp buf) buf (buffer-name buf))))))
  121.  
  122. ;;; end of dired-mob.el
  123.